home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok33.lha / Ersatzquelle / Ersatzquelle.mod < prev    next >
Text File  |  1993-08-15  |  28KB  |  738 lines
  1. (**********************************************************************
  2.  
  3.     :Program.       Ersatzquelle.mod
  4.     :Imports.    EQGadgets V1.0 [gs], GraphicLib V1.2.3 [gs] AMOK #28
  5.     :Imports.    ComplexLib V1.0 [gs] AMOK#20, MathLibExt V1.0 [gs] AMOK #20
  6.     :Imports.    PrinterSupport V2.01 (an m2c V3.3d angepasst) [mif] AMOK #8
  7.     :Author.        Gary Struhlik
  8.     :shortcut.   [gs]
  9.     :Version.       1.0
  10.     :Date.          24.10.89
  11.     :Modified.   10.02.90 (bessere Fehlerbehandlung)
  12.     :Copyright.  Dieses Programm habe ich als Public  Domain Programm frei-
  13.     :Copyright.  gegeben. Aus diesem Programm und  Programmteilen darf kein
  14.     :Copyright.  Gewinn erzielt werden. Die zweite Bedingung  ist, daß mein
  15.     :Copyright.  Name im Quellcode erhalten bleiben muß  und  daß  man  das
  16.     :Copyright.  Programm nur komplett mit Quellcode, compiliertes Programm
  17.     :Copyright.  und der Dokumentation weiter kopiert.  Änderungen  sollten
  18.     :Copyright.  bitte im Quellkopf mit Angabe des  Autors  angegeben  wer-
  19.     :Copyright.  den,  damit  nicht   1000  verschiedene  Versionen  herum-
  20.     :Copyright.  schwirren. Danke !!
  21.     :Language.      Modula-II
  22.     :Translator. M2Amiga AMSoft V3.3d, 28.11.89
  23.     :Contents.   Berechnet passive analoge Schaltungen bestehend aus Spulen
  24.     :Contents.   Kondensatoren, ohmschen Widerständen sowie starren  Strom-
  25.     :Contents.   und Spannungsquellen.
  26.     :Contents.   Die Schaltung  wird  als Ersatzspannungs- bzw. Stromquelle
  27.     :Contents.   betrachtet.
  28.     :History.    V 1.0 24.10.1989 [gs]
  29.  
  30. **********************************************************************)
  31.  
  32. MODULE Ersatzquelle;
  33.  
  34. FROM ComplexLib IMPORT COMPLEX,crcp,compop,crec,cpol;
  35. FROM InOut IMPORT WriteLn, WriteString;
  36. FROM RealInOut IMPORT ReadReal;
  37. IMPORT Intuition;
  38. FROM MathLib0 IMPORT ln,exp;
  39. FROM MathLibExt IMPORT log, PwrOfTen;
  40. FROM SYSTEM IMPORT ADR;
  41. FROM EQGadgets IMPORT MaleGadgets, GadgetAbfrage, EntferneGadgets,Auswahl,
  42.                       Anweisungen;
  43. FROM GraphicLib IMPORT gwrite,sx,sy,GraphOn,GraphOff,gmove,vector,graph1,
  44.                        STRING,textline,InitVector,xpos,ypos,ChSet,SetCross,
  45.                        HardCopy,GraphOffWithOutMouse;
  46. FROM Terminal IMPORT waitCloseGadget;
  47. FROM PrinterSupport IMPORT OpenPrinter,ClosePrinter,PrintChar,PrintString;
  48. FROM Strings IMPORT Copy, Length, Insert;
  49. FROM RealConversions IMPORT RealToStr;
  50. FROM Arts IMPORT TermProcedure;
  51.  
  52. CONST
  53.       MaxIndex = 2500;
  54. TYPE
  55.      Ausgabeform = (NUME,OKURV,BLIN,WLIN,BLOG,WLOG);
  56.      Quellenart = (Strom,Spannung,ZiNochNull); (* Flags für die Quellenart *)
  57.  
  58.      Zweipolspeicher = RECORD       (* Definition von Zweipolspeichern *)
  59.       CASE Quelle : Quellenart OF
  60.         Strom    : I,Y : COMPLEX |  (* Ersatzstromquelle *)
  61.         Spannung : U,Z : COMPLEX    (* Ersatzspannungsquelle *)
  62.       END
  63.      END;
  64. VAR
  65.      Makro : ARRAY [1..MaxIndex] OF Auswahl;
  66.                                        (* Speicherfeld für alle Anweisungen *)
  67.      Wert  : ARRAY [1..MaxIndex] OF REAL;   (* eventuell dazugehöriger Wert *)
  68.      MaxAnzAnw, Index, Input : CARDINAL;
  69.      Ausfuehrung, Eingabe : Anweisungen;
  70.      Ersatzquelle : Quellenart;
  71.      A,B,C,D : Zweipolspeicher; (* 4 Zweipolspeicher definieren *)
  72.      Anweisungscode : Auswahl;
  73.      IntuiBase : Intuition.IntuitionBasePtr;
  74.      aktuellesFenster : Intuition.WindowPtr;
  75.      Druckflag,RECflag,err,PrinterOffen,GraphicFenster,
  76.      BefehlsFenster : BOOLEAN;
  77.      W,XA,XE,YA,YE,YE1,YA1,WH,Schritt,W1,W2,X2,X,Y : REAL;
  78.      X1,Eingabeform,Umformung,AusgW : COMPLEX;
  79.      AusArt : Ausgabeform;
  80.      OX,OY : INTEGER;
  81.      xcom,ycom : STRING;
  82.      Text,reelleZahl,s1,s2 : ARRAY [0..80] OF CHAR;
  83.      Marke : textline;
  84.      P1,P2,Einheit : ARRAY [0..20] OF CHAR;
  85.      NextLine : PROC;
  86.      WriteText : PROCEDURE (ARRAY OF CHAR);
  87.  
  88. PROCEDURE PrintLn; (* Zeilenvorschub (Drucker) *)
  89. BEGIN
  90.    PrintChar(CHAR(10)); PrintChar(CHAR(13))
  91. END PrintLn;
  92.  
  93.        (* Aus dem Code soll ein Klartext gedruckt werden *)
  94. PROCEDURE Anzeigen( Ausw : Auswahl);
  95. BEGIN
  96.      CASE Ausw OF
  97.         RR : WriteText("RR/Ohm =") |
  98.         RP : WriteText("RP/Ohm =") |
  99.         XR : WriteText("XR/Ohm =") |
  100.         XP : WriteText("XP/Ohm =") |
  101.         LR : WriteText("LR/H =") |
  102.         LP : WriteText("LP/H =") |
  103.         CR : WriteText("CR/F =") |
  104.         CP : WriteText("CP/F =") |
  105.         U1 : IF RECflag THEN
  106.                WriteText("Re{U}/V =")
  107.              ELSE
  108.                WriteText("|U|/V =")
  109.              END |
  110.         I1 : IF RECflag THEN
  111.                WriteText("Re{I}/A =")
  112.              ELSE
  113.                WriteText("|I|/A =")
  114.              END |
  115.         U2 : IF RECflag THEN
  116.                WriteText("Im{U}/V =")
  117.              ELSE
  118.                WriteText("<U/Grad =")
  119.              END |
  120.         I2 :IF RECflag THEN
  121.                WriteText("Im{I}/A =")
  122.              ELSE
  123.                WriteText("<I/Grad =")
  124.              END |
  125.         RS : WriteText("RS") |
  126.         PS : WriteText("PS") |
  127.         U0 : WriteText("U0") |
  128.         IK : WriteText("IK") |
  129.         ZI : WriteText("ZI") |
  130.        AnB : WriteText("A->B") |
  131.        AnC : WriteText("A->C") |
  132.        BvC : WriteText("B<=>C") |
  133.         EE : WriteText("EE")
  134.      END
  135. END Anzeigen;
  136.  
  137. (* Es wird eine eigene Prozedur WriteComplex definiert, da auch eine *)
  138. (* Druckerausgabe erfolgen soll, sonst würde ich natürlich von dem   *)
  139. (* Modul ComplexInOut importieren !                                  *)
  140. (* Diese Prozedur ist voll kompatibel nur wird WriteText anstatt     *)
  141. (* WriteString benutzt                                               *)
  142. PROCEDURE WriteComplex( A : COMPLEX; m,n : INTEGER; expo,pol : BOOLEAN );
  143. VAR
  144.         logo : BOOLEAN;
  145.         x : REAL;
  146.         Y : COMPLEX;
  147. BEGIN
  148.    IF NOT pol THEN
  149.     x:=ABS(A.IM);
  150.     RealToStr(A.RE,s1,m,n,expo,logo);
  151.     RealToStr(x,s2,m,n,expo,logo);
  152.     IF A.IM >= 0.0 THEN
  153.           WriteText(s1); WriteText("+j"); WriteText(s2)
  154.         ELSE
  155.           WriteText(s1); WriteText("-j"); WriteText(s2)
  156.         END
  157.    ELSE
  158.         cpol(Y,A); (* A in Polarform umwandeln *)
  159.         RealToStr(Y.RE,s1,m,n,expo,logo);
  160.         RealToStr(Y.IM,s2,m,n,expo,logo);
  161.         WriteText(s1); WriteText(" <"); WriteText(s2)
  162.    END
  163. END WriteComplex;
  164.  
  165. (* Definition einer eigenen WriteReal Prozedur, weil eine Ausgabe in       *)
  166. (* wissenschaftlicher Schreibweise erfolgen soll und eine Druckerausgabe ! *)
  167. PROCEDURE WriteReal(x : REAL; m,n : INTEGER; expo : BOOLEAN);
  168. VAR
  169.        error : BOOLEAN;
  170. BEGIN
  171.      RealToStr(x,reelleZahl,m,n,expo,error);
  172.      WriteText(reelleZahl);
  173. END WriteReal;
  174.  
  175. PROCEDURE WerteAnzeigen( Index : CARDINAL);
  176. BEGIN          (* eventuell Werte der aktuellen Anweisung ausgeben *)
  177.  Anzeigen(Makro[Index]);
  178.  IF Makro[Index] IN Eingabe THEN
  179.   CASE Makro[Index] OF
  180.     I1,U1: IF NOT(RECflag) THEN
  181.              Umformung.RE:=Wert[Index];
  182.              Umformung.IM:=Wert[Index+1];
  183.              cpol(Umformung,Umformung);
  184.              WriteReal(Umformung.RE,13,6,FALSE)
  185.            ELSE
  186.              WriteReal(Wert[Index],13,6,FALSE)
  187.            END |
  188.     I2,U2: IF NOT(RECflag) THEN
  189.              Umformung.RE:=Wert[Index-1];
  190.              Umformung.IM:=Wert[Index];
  191.              cpol(Umformung,Umformung);
  192.              WriteReal(Umformung.IM,13,6,FALSE)
  193.            ELSE
  194.              WriteReal(Wert[Index],13,6,FALSE)
  195.            END
  196.      ELSE CASE Makro[Index] OF
  197.            LR,CR,LP,CP : WriteReal(Wert[Index],13,6,TRUE)
  198.            ELSE          WriteReal(Wert[Index],13,6,FALSE)
  199.           END
  200.   END
  201.  END;
  202.  NextLine
  203. END WerteAnzeigen;
  204.  
  205. PROCEDURE MakrosAnzeigen; (* Die gesamte Schaltung ausgeben *)
  206. VAR
  207.      Index : CARDINAL;
  208. BEGIN
  209.    IF MaxAnzAnw > 1 THEN
  210.      Index:=1;
  211.      NextLine;
  212.      WHILE Makro[Index]<>EE DO
  213.        WerteAnzeigen(Index);
  214.        INC(Index)
  215.      END;
  216.      WerteAnzeigen(Index);
  217.    ELSE
  218.      WriteString("keine Bauelemente gespeichert !"); WriteLn
  219.    END
  220. END MakrosAnzeigen;
  221.  
  222.    (* Den Zweipolspeicher ZP löschen *)
  223. PROCEDURE LoescheZPSpeicher( VAR ZP : Zweipolspeicher);
  224. BEGIN   (* hier als Ersatzspannungsquelle betrachtet *)
  225.     ZP.U.RE:=0.0; ZP.U.IM:=0.0; ZP.Z.RE:=0.0; ZP.Z.IM:=0.0
  226. END LoescheZPSpeicher;
  227.  
  228.    (* In die erforderliche Ersatzquelle umrechnen *)
  229. PROCEDURE Quellenumformung(VAR ZP : Zweipolspeicher);
  230. BEGIN
  231.     CASE Ersatzquelle OF
  232.        Strom: (* in Ersatzstromquelle umwandeln *)
  233.               crcp(ZP.Y,ZP.Z); (* YI=1/ZI *)
  234.               compop(ZP.I,ZP.U,"*",ZP.Y) | (* IK=U0*YI *)
  235.     Spannung: (* in Ersatzspannungsquelle umwandeln *)
  236.               crcp(ZP.Z,ZP.Y); (* ZI=1/YI *)
  237.               compop(ZP.U,ZP.I,"*",ZP.Z); (* U0=IK*ZI *)
  238.     END (* CASE *)
  239. END Quellenumformung;
  240.  
  241.   (* Überprüft, ob umgeformt werden kann, Grenzfälle ZI->0 => YI -> oo  *)
  242.   (* Damit Schwierigkeiten vermieden werden. Falls am Anfang gleich I   *)
  243.   (* oder RP o.ä. eingegeben wird.                                      *)
  244. PROCEDURE QuellenumformungErlaubt;
  245. BEGIN
  246.     IF (Ersatzquelle=ZiNochNull) THEN
  247.        Ersatzquelle:=Strom
  248.     ELSE
  249.        Ersatzquelle:=Strom; Quellenumformung(A)
  250.     END
  251. END QuellenumformungErlaubt;
  252.  
  253. PROCEDURE Ten ( X : REAL ) : REAL; (* 10^X *)
  254. BEGIN
  255.     RETURN exp(X*ln(10.0))
  256. END Ten;
  257.  
  258. PROCEDURE Log ( X : REAL ) : REAL; (* Zehnerlogarithmus *)
  259. BEGIN
  260.     RETURN ln(X)/ln(10.0)
  261. END Log;
  262.  
  263. PROCEDURE Ausgabe;
  264.  
  265.  PROCEDURE Bezeichne; (* Ausgabe der berechneten Werte *)
  266.  BEGIN
  267.     OX:=xpos; OY:=ypos; ChSet(0.0218,0.0420,0.0);
  268.     SetCross; (* Markierung der Frequenz *)
  269.         RealToStr(W,Marke,10,2,TRUE,err);
  270.     Insert(Marke,0,"w=");
  271.     Insert(Marke,Length(Marke)," 1/s");
  272.     gwrite(sx(X)+0.009,sy(Y)-0.008,Marke);
  273.     xpos:=OX; ypos:=OY
  274.  END Bezeichne;
  275.  
  276. BEGIN
  277.   CASE AusArt OF
  278.   NUME: (* numerisch ausgeben *)
  279.        WriteText("Kreisfrequenz = "); WriteReal(W,13,6,FALSE);
  280.        WriteText(" 1/s "); NextLine;
  281.        WriteText(P1); WriteText(" = ");
  282.        AusgW.RE:=X; AusgW.IM:=Y;
  283.        WriteComplex(AusgW,13,6,FALSE,NOT(RECflag));
  284.        WriteText(" "); WriteText(Einheit);
  285.        NextLine |
  286.   OKURV: (* Ortskurve zeichnen *)
  287.        IF W=W1 THEN
  288.          RealToStr(W,Marke,10,2,TRUE,err);
  289.      Insert(Marke,0,"w="); ChSet(0.0218,0.0420,0.0);
  290.      Insert(Marke,Length(Marke)," 1/s");
  291.      gwrite(sx(X)+0.009,sy(Y)-0.008,Marke);
  292.      gmove( sx(X), sy(Y));
  293.          SetCross
  294.        END;
  295.        IF W=W1+REAL(TRUNC((W2-W1)/Schritt))*Schritt THEN
  296.           Bezeichne
  297.        END;
  298.        IF W=W1+REAL(TRUNC((W2-W1)/(8.0*Schritt)))*Schritt THEN
  299.           Bezeichne
  300.        END;
  301.        IF W=W1+REAL(TRUNC((W2-W1)/(6.0*Schritt)))*Schritt THEN
  302.           Bezeichne
  303.        END;
  304.        vector(sx(X),sy(Y))
  305.       |
  306.   BLIN: (* Betrag |F|(w) graphisch darstellen *)
  307.        X1.RE:=X; X1.IM:=Y;
  308.        cpol(X1,X1);
  309.        X:=X1.RE; Y:=X1.IM; (* Betrag entspricht X *)
  310.        IF W=W1 THEN
  311.          gmove( sx(W),sy(X))
  312.        END;
  313.        vector( sx(W),sy(X))
  314.       |
  315.   WLIN: (* Phase Phi(w) graphisch darstellen *)
  316.        X1.RE:=X; X1.IM:=Y;
  317.        cpol(X1,X1);
  318.        X:=X1.RE; Y:=X1.IM; (* Phase entspricht Y *)
  319.        IF W=W1 THEN
  320.          gmove( sx(W),sy(Y))
  321.        END;
  322.        vector( sx(W),sy(Y))
  323.       |
  324.   BLOG: (* Betrag |F|/dB(lgw) graphisch darstellen (doppelt log.) *)
  325.        X1.RE:=X; X1.IM:=Y;
  326.        cpol(X1,X1);
  327.        X:=X1.RE; Y:=X1.IM; (* Betrag entspricht X *)
  328.        IF WH=W1 THEN
  329.          gmove( sx(Log(W)),sy(20.0*Log(X)) )
  330.        END;
  331.        vector( sx(Log(W)),sy(20.0*Log(X)) )
  332.       |
  333.   WLOG: (* Phase Phi(lgw) graphisch darstellen (halblog.) *)
  334.        X1.RE:=X; X1.IM:=Y;
  335.        cpol(X1,X1);
  336.        X:=X1.RE; Y:=X1.IM; (* Phase entspricht Y *)
  337.        IF WH=W1 THEN
  338.          gmove( sx(Log(W)),sy(Y))
  339.        END;
  340.        vector( sx(Log(W)),sy(Y))
  341.    END (* CASE *)
  342. END Ausgabe;
  343.  
  344. PROCEDURE Berechne;
  345. BEGIN
  346.     LoescheZPSpeicher(A); Index:=1;
  347.     WHILE Makro[Index]<>EE DO
  348.       IF Makro[Index]=U0 THEN
  349.         Einheit:="V"; P1:="U0"
  350.       ELSIF Makro[Index]=IK THEN
  351.         Einheit:="A"; P1:="IK"
  352.       ELSIF Makro[Index]=ZI THEN
  353.         Einheit:="Ohm"; P1:="ZI"
  354.       END;
  355.       (* Der Innenwiderstand wird überprüft, ob er von Null verschieden ist, *)
  356.       (* da bei einer Quellenumrechnung sonst eine Division durch Null er-   *)
  357.       (* folgen würde :                                                      *)
  358.        IF (A.Z.RE=0.0) AND (A.Z.IM=0.0) THEN
  359.           Ersatzquelle:=ZiNochNull
  360.        ELSE
  361.           Ersatzquelle:=Spannung
  362.        END;
  363.        CASE Makro[Index] OF
  364.  
  365.        RR: A.Z.RE:=A.Z.RE+Wert[Index] | (* summiere RR in ZPS-A hinein *)
  366.  
  367.        RP: QuellenumformungErlaubt;
  368.                                            (* Rechne ggf. in Stromquelle um  *)
  369.            A.Y.RE:=A.Y.RE+1.0/Wert[Index]; (* summiere YP in    ZPS-A hin-   *)
  370.            Ersatzquelle:=Spannung;         (* ein ->Spannungsquelle          *)
  371.            Quellenumformung(A) |
  372.  
  373.        XR: A.Z.IM:=A.Z.IM+Wert[Index] | (* summiere jXR in ZPS-A hinein *)
  374.  
  375.        XP: QuellenumformungErlaubt;
  376.                                            (* Rechne ggf. in Stromquelle um *)
  377.            A.Y.IM:=A.Y.IM-1.0/Wert[Index]; (* summiere 1/jXP in ZPS-A hin-  *)
  378.            Ersatzquelle:=Spannung;         (* ein ->Spannungsquelle         *)
  379.            Quellenumformung(A) |
  380.  
  381.        LR: A.Z.IM:=A.Z.IM+W*Wert[Index] | (* summiere jwLR in ZPS-A hinein *)
  382.  
  383.        LP: QuellenumformungErlaubt;
  384.                                             (* Rechne ggf. in Stromquelle um *)
  385.            A.Y.IM:=A.Y.IM-1.0/(W*Wert[Index]);(*summiere 1/jwLP in ZPS-A hin-*)
  386.            Ersatzquelle:=Spannung;            (* ein ->Spannungsquelle       *)
  387.            Quellenumformung(A) |
  388.  
  389.        CR: A.Z.IM:=A.Z.IM-1.0/(W*Wert[Index]) | (* summiere 1/jwCR in ZPS-A *)
  390.                                                 (* hinein *)
  391.  
  392.        CP: QuellenumformungErlaubt;
  393.                                            (* Rechne ggf. in Stromquelle um *)
  394.            A.Y.IM:=A.Y.IM+W*Wert[Index];   (* summiere jwCP in ZPS-A hin-   *)
  395.            Ersatzquelle:=Spannung;         (* ein ->Spannungsquelle         *)
  396.            Quellenumformung(A) |
  397.  
  398.        U1: IF (Makro[Index+1]=U2) THEN
  399.               (* summiere Re{U} in ZPS-A hinein *)
  400.               A.U.RE:=A.U.RE+Wert[Index]
  401.            ELSE
  402.               WriteString("Die nächste Anweisung muß U2 lauten !"); WriteLn;
  403.               WriteString("Bitte Korrektur durchführen !"); WriteLn
  404.            END |
  405.  
  406.        I1: IF (Makro[Index+1]=I2) THEN
  407.              IF Ersatzquelle=ZiNochNull THEN
  408.                 A.I.RE:=A.I.RE+Wert[Index]; Ersatzquelle:=ZiNochNull
  409.              ELSE
  410.                Ersatzquelle:=Strom; Quellenumformung(A);
  411.                                              (* Rechne ggf. in Stromquelle um *)
  412.                A.I.RE:=A.I.RE+Wert[Index];   (* summiere I in ZPS-A hin-      *)
  413.                Ersatzquelle:=Spannung;       (* ein ->Spannungsquelle         *)
  414.                Quellenumformung(A)
  415.              END
  416.            ELSE
  417.              WriteString("Die nächste Anweisung muß I2 lauten !"); WriteLn;
  418.              WriteString("Bitte Korrektur durchführen !"); WriteLn
  419.            END |
  420.  
  421.        U2: IF (Makro[Index-1]=U1) THEN
  422.               A.U.IM:=A.U.IM+Wert[Index] (* summiere Im{U} in ZPS-A hinein *)
  423.            ELSE
  424.               WriteString("Die vorherige Anweisung muß U1 lauten !"); WriteLn;
  425.               WriteString("Bitte Korrektur durchführen !"); WriteLn
  426.            END |
  427.  
  428.        I2: IF (Makro[Index-1]=I1) THEN
  429.              IF Ersatzquelle=ZiNochNull THEN
  430.                 A.I.IM:=A.I.IM+Wert[Index]; Ersatzquelle:=ZiNochNull
  431.              ELSE
  432.                Ersatzquelle:=Strom; Quellenumformung(A);
  433.                                              (* Rechne ggf. in Stromquelle um *)
  434.                A.I.IM:=A.I.IM+Wert[Index];   (* summiere I in ZPS-A hin-      *)
  435.                Ersatzquelle:=Spannung;       (* ein ->Spannungsquelle         *)
  436.                Quellenumformung(A)
  437.              END
  438.               ELSE
  439.                 WriteString("Die vorherige Anweisung muß I1 lauten !"); WriteLn;
  440.                 WriteString("Bitte Korrektur durchführen !"); WriteLn
  441.               END |
  442.  
  443.        RS: compop(A.U,A.U,"+",B.U); (* Spannungen addieren *)
  444.            compop(A.Z,A.Z,"+",B.Z) | (* Innenwiderstände addieren *)
  445.  
  446.        PS: Ersatzquelle:=Strom; Quellenumformung(A); Quellenumformung(B);
  447.            compop(A.I,A.I,"+",B.I); (* Ströme addieren *)
  448.            compop(A.Y,A.Y,"+",B.Y); (* Leitwerte addieren *)
  449.            Ersatzquelle:=Spannung; Quellenumformung(A); Quellenumformung(B) |
  450.  
  451.        U0: X:=A.U.RE; Y:=A.U.IM; Ausgabe |
  452.                  (* Spannungswert der Ersatzquelle ausgeben *)
  453.  
  454.        IK: Ersatzquelle:=Strom; Quellenumformung(A);
  455.            X:=A.I.RE; Y:=A.I.IM; Ausgabe;
  456.            Ersatzquelle:=Spannung; Quellenumformung(A) |
  457.                  (* Strom der Ersatzquelle ausgeben *)
  458.  
  459.        ZI: X:=A.Z.RE; Y:=A.Z.IM; Ausgabe |
  460.                  (* Innenwiderstand der Ersatzquelle ausgeben *)
  461.  
  462.       AnB: B:=A;                   (* A -> B ; 0 -> A *)
  463.            LoescheZPSpeicher(A) |
  464.  
  465.       AnC: C:=A;                   (* A -> C ; 0 -> A *)
  466.            LoescheZPSpeicher(A) |
  467.  
  468.       BvC: D:=B; B:=C; C:=D        (* B und C vertauschen *)
  469.  
  470.        END; (* CASE *)
  471.        INC(Index)
  472.     END (* WHILE *)
  473. END Berechne;
  474.  
  475. PROCEDURE Abfragen; (* Abfrage der Intervallgrenzen und der Schrittweite *)
  476. BEGIN
  477.         WHILE ((W1=0.0) OR (W2=0.0)) DO
  478.             WriteString("Geben Sie die Anfangskreisfrequenz für Schaltungen");
  479.             WriteLn; WriteString("mit L und C ein."); WriteLn;
  480.             WriteString("w1 = "); ReadReal(W1); WriteLn;
  481.             WriteString("Geben Sie die Endkreisfrequenz für Schaltungen");
  482.             WriteLn; WriteString("mit L und C ein."); WriteLn;
  483.             WriteString("w2 = "); ReadReal(W2); WriteLn
  484.         END;
  485.         WriteString("Geben Sie die Schrittweite ein."); WriteLn;
  486.         WriteString("s = "); ReadReal(Schritt); WriteLn
  487. END Abfragen;
  488.  
  489. PROCEDURE NachAbsturz;
  490. BEGIN
  491.     IF PrinterOffen THEN ClosePrinter END;
  492.     IF GraphicFenster THEN GraphOffWithOutMouse END;
  493.     IF BefehlsFenster THEN EntferneGadgets END
  494. END NachAbsturz;
  495.  
  496. BEGIN (* Hauptprogramm *)
  497.     GraphicFenster:=FALSE; PrinterOffen:=FALSE; BefehlsFenster:=FALSE;
  498.     TermProcedure(NachAbsturz);
  499.     OpenPrinter; PrinterOffen:=TRUE;
  500.     Druckflag:=FALSE; (* FALSE = keine Ausgabe auf dem Drucker *)
  501.     RECflag:=FALSE; (* FALSE = keine Ausgabe in Normalform *)
  502.     IntuiBase:=ADR(Intuition); (* Für die Abfrage des aktiven Fensters *)
  503.     aktuellesFenster:=IntuiBase^.activeWindow; (* Hole Adresse des *)
  504.                                                (* aktiven Fensters *)
  505.     waitCloseGadget:=FALSE;(* Wenn PEND angeklickt wird -> Workbench Fenster *)
  506.                            (* schließen                                      *)
  507.     WriteLn;
  508.     WriteString("Dieses Programm kann eine einfache passive analoge Schaltung");
  509.     WriteLn;
  510.     WriteString("bestehend aus ohmschen Widerständen,  Spulen,  Kondensatoren");
  511.     WriteLn;
  512.     WriteString("und starren Spannungs- und Stromquellen berechnen.");
  513.     WriteLn; WriteLn;
  514.     WriteString("Es  kann mit Quellen sinusförmiger  Ausgangsgrößen oder mit");
  515.     WriteLn;
  516.     WriteString("Gleichgrößen gerechnet werden."); WriteLn;
  517.     WriteString("Die Schaltung wird  als  Ersatzspannungsquelle  betrachtet.");
  518.     WriteLn; WriteLn;
  519.     WriteString("======== Bitte  die Bedienungsanleitung beachten ! ========");
  520.     WriteLn;
  521.     WriteString("========     Version 1.0 ist Public Domain !       ========");
  522.     WriteLn; WriteLn;
  523.     MaleGadgets; (* Fenster mit Gadgets öffnen *) BefehlsFenster:=TRUE;
  524.     Index:=1;               (* Den Speicherindex initialisieren *)
  525.     MaxAnzAnw:=Index;       (* maximale Anzahl der eingegebenen Anweisungen *)
  526.     Eingabe:=Anweisungen{RR,RP,LR,LP,CR,CP,XR,XP,U1,I1,U2,I2};
  527.     Ausfuehrung:=Anweisungen{VOR,RCK,NUM,BODELIN,BODELOG,OK,NS,ANWAZ};
  528.  
  529.     GadgetAbfrage(Anweisungscode,Druckflag,RECflag);
  530.                              (* Welches Gadget wurde gewählt ? *)
  531.     Intuition.ActivateWindow(aktuellesFenster);
  532.    (* Damit der Benutzer nicht zwischen den Fenstern hin und her klicken muß *)
  533.     IF Druckflag THEN WriteText:=PrintString; NextLine:=PrintLn
  534.                  ELSE WriteText:=WriteString; NextLine:=WriteLn END;
  535.  
  536.     WHILE Anweisungscode <> PEND DO
  537.       IF Anweisungscode IN Ausfuehrung THEN
  538.          CASE Anweisungscode OF
  539.            VOR : IF Index <= 65534 THEN (* Bereichskontrolle *)
  540.                   INC(Index);
  541.                   IF Index < MaxAnzAnw THEN           (* in der Liste eine *)
  542.                     WerteAnzeigen(Index)              (* Anweisung vor     *)
  543.                   ELSE
  544.                     Index:=MaxAnzAnw-1;
  545.                     IF Index = 0 THEN Index:=1 END
  546.                   END
  547.                  ELSE
  548.                    Index:=MaxAnzAnw-1;
  549.                    IF Index = 0 THEN Index:=1 END
  550.                  END |
  551.            RCK : IF Index > 0 THEN (* Bereichskontrolle *)
  552.                   DEC(Index);
  553.                   IF Index > 0 THEN         (* In der Liste eine *)
  554.              WerteAnzeigen(Index)    (* Anweisung zurück  *)
  555.                   ELSE
  556.                     Index:=1
  557.                   END
  558.              ELSE
  559.                Index:=1
  560.              END |
  561.         NUM: IF MaxAnzAnw>1 THEN (* Die Rechnung soll numerisch erfolgen *)
  562.                    AusArt:=NUME; W:=0.0;
  563.                    WHILE W=0.0 DO
  564.                     WriteLn;
  565.                 WriteString("Geben Sie die Kreisfrequenz für Schaltungen");
  566.                 WriteString(" mit L und C ein oder eine"); WriteLn;
  567.                 WriteString("von 0.0 verschiedene Zahl."); WriteLn;
  568.                 WriteString("w = "); ReadReal(W); WriteLn;
  569.                    END;
  570.                Berechne
  571.              ELSE
  572.                WriteString("Bitte die Bauelemente eingeben !"); WriteLn
  573.              END |
  574.     OK:IF MaxAnzAnw>1 THEN
  575.         AusArt:=OKURV;
  576.         WriteLn; W1:=0.0; W2:=0.0;
  577.         WriteString("Aufnahme einer Ortskurve"); WriteLn;
  578.         WriteString("Nur bei Eingabe von L und C sinnvoll !"); WriteLn;
  579.         WriteLn;
  580.         Abfragen;
  581.         W:=W1;
  582.         WriteString("Geben Sie die Bereiche der komplexen Zahlenebene ein.");
  583.         WriteLn; WriteString("Re{Z}min = "); ReadReal(XA); WriteLn;
  584.                  WriteString("Re{Z}max = "); ReadReal(XE); WriteLn;
  585.                  WriteString("Im{Z}min = "); ReadReal(YA); WriteLn;
  586.                  WriteString("Im{Z}max = "); ReadReal(YE); WriteLn;
  587.                  GraphOn; GraphicFenster:=TRUE;
  588.                  InitVector; xcom:="Re/"; ycom:="jIm/";
  589.                  Insert(xcom,3,Einheit);
  590.                  Insert(ycom,4,Einheit);
  591.                  graph1(2,XA,XE,5,YA,YE,5,0.16,0.98,0.13,0.93,"ORTSKURVE",
  592.                         xcom,ycom);
  593.                  WHILE W<=W2 DO
  594.                    Berechne; W:=W+Schritt
  595.                  END;
  596.                  IF Druckflag THEN HardCopy END;
  597.                  GraphOff; GraphicFenster:=FALSE
  598.        ELSE
  599.             WriteString("Bitte die Bauelemente eingeben !"); WriteLn
  600.        END |
  601.  BODELIN:
  602.        IF MaxAnzAnw > 1 THEN
  603.         WriteLn; W1:=0.0; W2:=0.0;
  604.         WriteString("Aufnahme des Betrages und der Phase."); WriteLn;
  605.         WriteString("Nur bei Eingabe von L und C sinnvoll !"); WriteLn;
  606.         WriteLn;
  607.         Abfragen; Copy(P2,P1,0,1);
  608.         WriteString("Geben Sie Bereiche des Betrages ein."); WriteLn;
  609.         WriteString("|"); WriteString(P2);
  610.     WriteString("| min = "); ReadReal(YA); WriteLn;
  611.         WriteString("|"); WriteString(P2);
  612.         WriteString("| max = "); ReadReal(YE); WriteLn;
  613.         WriteString("Geben Sie die Bereiche der Phase ein."); WriteLn;
  614.         WriteString("Phi min = "); ReadReal(YA1); WriteLn;
  615.         WriteString("Phi max = "); ReadReal(YE1); WriteLn;
  616.         GraphOn; GraphicFenster:=TRUE;
  617.         InitVector; ycom:="||/"; Insert(ycom,1,P2);
  618.         xcom:="w/(1/s)";
  619.         Insert(ycom,4,Einheit);
  620.         graph1(2,W1,W2,5,YA,YE,5,0.16,0.98,0.13,0.93,"Amplitudenverlauf",
  621.                xcom,ycom);
  622.         W:=W1;
  623.         AusArt:=BLIN;
  624.         WHILE W<=W2 DO
  625.           Berechne; W:=W+Schritt
  626.         END;
  627.         IF Druckflag THEN HardCopy END;
  628.         GraphOff; GraphicFenster:=FALSE;
  629.         GraphOn; GraphicFenster:=TRUE; InitVector;
  630.         ycom:="Phi/o"; xcom:="w/(1/s)";
  631.         graph1(2,W1,W2,5,YA1,YE1,5,0.16,0.98,0.13,0.93,"Phasenverlauf",
  632.                xcom,ycom);
  633.         W:=W1;
  634.         AusArt:=WLIN;
  635.         WHILE W<=W2 DO
  636.           Berechne; W:=W+Schritt
  637.         END;
  638.         IF Druckflag THEN HardCopy END;
  639.         GraphOff; GraphicFenster:=FALSE
  640.        ELSE
  641.          WriteString("Bitte die Bauelemente eingeben !"); WriteLn
  642.        END |
  643. BODELOG:
  644.        IF MaxAnzAnw > 1 THEN
  645.         WriteLn; W1:=0.0; W2:=0.0;
  646.         WriteString("Aufnahme eines Bodediagrammes mit logarithmischer");
  647.         WriteLn; WriteString("Frequenzachse und Betrag in dB."); WriteLn;
  648.         WriteString("Nur bei Eingabe von L und C und bei");
  649.         WriteString(" Berechnung");  WriteLn;
  650.         WriteString("mit Spannungswerten sinnvoll !"); WriteLn; WriteLn;
  651.         WriteString("Geben Sie die Frequenz, den Betrag und die Schritt");
  652.         WriteString("weite logarithmisch ein !"); WriteLn; WriteLn;
  653.         Abfragen;
  654.         WriteString("Geben Sie die Bereiche des Betrages ein."); WriteLn;
  655.         WriteString("|F|/dB min = "); ReadReal(YA); WriteLn;
  656.         WriteString("|F|/dB max = "); ReadReal(YE); WriteLn;
  657.         WriteString("Geben Sie die Bereiche der Phase ein."); WriteLn;
  658.         WriteString("Phi min = "); ReadReal(YA1); WriteLn;
  659.         WriteString("Phi max = "); ReadReal(YE1); WriteLn;
  660.         GraphOn; GraphicFenster:=TRUE; InitVector;
  661.         ycom:="|F|/dB"; xcom:="lg(w)";
  662.         graph1(2,W1,W2,5,YA,YE,5,0.16,0.98,0.13,0.93,"Amplitudenverlauf",
  663.                xcom,ycom);
  664.         WH:=W1;
  665.         AusArt:=BLOG;
  666.         WHILE WH<=W2 DO
  667.           W:=Ten(WH);
  668.           Berechne; WH:=WH+Schritt
  669.         END;
  670.         IF Druckflag THEN HardCopy END;
  671.         GraphOff; GraphicFenster:=FALSE;
  672.         GraphOn; GraphicFenster:=TRUE; InitVector;
  673.         ycom:="Phi/o"; xcom:="lg(w)";
  674.         graph1(2,W1,W2,5,YA1,YE1,5,0.16,0.98,0.13,0.93,"Phasenverlauf",
  675.                xcom,ycom);
  676.         WH:=W1;
  677.         AusArt:=WLOG;
  678.         WHILE WH<=W2 DO
  679.           W:=Ten(WH);
  680.           Berechne; WH:=WH+Schritt
  681.         END;
  682.         IF Druckflag THEN HardCopy END;
  683.         GraphOff; GraphicFenster:=FALSE
  684.        ELSE
  685.         WriteString("Bitte die Bauelemente eingeben !"); WriteLn
  686.        END |
  687.     NS: Index:=1; MaxAnzAnw:=1 | (* Neue Schaltung eingeben  *)
  688.     ANWAZ: MakrosAnzeigen (* alle Eingaben anzeigen *)
  689.      END (* CASE *)
  690.      ELSE
  691.       IF Index < (MaxIndex-1) THEN
  692.        IF (Anweisungscode<>DR) AND (Anweisungscode<>RECPOL) THEN
  693.      Anzeigen( Anweisungscode);
  694.      Makro[Index]:=Anweisungscode;
  695.      IF Makro[Index]=U0 THEN
  696.            Einheit:="V"; P1:="U0"
  697.          ELSIF Makro[Index]=IK THEN
  698.            Einheit:="A"; P1:="IK"
  699.          ELSIF Makro[Index]=ZI THEN
  700.            Einheit:="Ohm"; P1:="ZI"
  701.          END;
  702.      IF Anweisungscode IN Eingabe THEN
  703.        ReadReal(Wert[Index]);
  704.        Anzeigen(Makro[Index]);
  705.        CASE Makro[Index] OF
  706.          LR,CR,LP,CP : WriteReal(Wert[Index],13,6,TRUE)
  707.          ELSE          WriteReal(Wert[Index],13,6,FALSE)
  708.        END;
  709.         IF (Anweisungscode=U2) OR (Anweisungscode=I2) THEN
  710.              IF NOT(RECflag) THEN             (* Werte stets in Normalform *)
  711.                 Umformung.RE:=Wert[Index-1];  (* speichern *)
  712.                 Umformung.IM:=Wert[Index];
  713.                 crec(Umformung,Umformung);
  714.                 Wert[Index-1]:=Umformung.RE;
  715.                 Wert[Index]:=Umformung.IM
  716.              END
  717.            END
  718.      END;
  719.      WriteLn;
  720.      INC(Index);
  721.      IF MaxAnzAnw < Index THEN
  722.         MaxAnzAnw:=Index
  723.      END
  724.        END
  725.       ELSE
  726.        WriteString("Zu viele Anweisungen eingegeben !!"); WriteLn
  727.       END
  728.      END;
  729.      GadgetAbfrage(Anweisungscode,Druckflag,RECflag);
  730.              (* Welches Gadget wurde gewählt ? *)
  731.      Intuition.ActivateWindow(aktuellesFenster);
  732.      IF Druckflag THEN WriteText:=PrintString; NextLine:=PrintLn
  733.                   ELSE WriteText:=WriteString; NextLine:=WriteLn END;
  734.     END;
  735.     EntferneGadgets; BefehlsFenster:=FALSE;
  736.     ClosePrinter; PrinterOffen:=FALSE
  737. END Ersatzquelle.
  738.